* Моделирование силлогистики (схема логических рассуждений по Аристотелю)
* Описание подхода: Поспелов Д.А. Моделирование рассуждений. Опыт анализа мыслительных актов. 
* Москва, Радио и связь, 1989. Стр.34-60.  http://www.aiportal.ru/downloads/books/modeling-of-reasoning-by-pospelov.html
* Программа КОНЦЕПТ, 23.01.2011, www.gendoc.ru

присвоить БАЗА_ФАКТОВ "[$ТекущийКаталог]Syllogism-db.txt"

если (файл существует $результат [БАЗА_ФАКТОВ] )
  данные загрузить [БАЗА_ФАКТОВ]
иначе
* Инициализация базы фактов
  факт добавить s;<факт>;<тип>;<субъект>;<предикат> \
    i;Евгений;<объект> \
    i;Татьяна;<объект> \
    r;<факт>;A;Евгений;мужчина \
    r;<факт>;A;Татьяна;женщина \
    r;<факт>;A;мужчина;человек \
    r;<факт>;A;женщина;человек \
    r;<факт>;E;мужчина;женщина \
    r;<факт>;I;студент;спортсмен
конец

присвоить ВыбранноеДействие Пропустить
пока [ВыбранноеДействие] != Выход
  выбрать [ВыбранноеДействие]
    вариант Пропустить;Выход
      * Ничего не делаем
    вариант 'Ввести факт'
      Ввести_факт
    вариант 'Посмотреть факты'
      Посмотреть_факты
    вариант 'Вывод новых фактов'
      Вывод_новых_фактов
  конецВыбора
  ввести меню1 ВыбранноеДействие 'Выберите действие:' 'Посмотреть факты;Вывод новых фактов;Ввести факт;Выход'
цикл

данные сохранить [БАЗА_ФАКТОВ]

****** Ввод новых фактов ******

функция Ввести_факт
множество или ВсеСущности \ 
  (факт домен $результат <факт> <субъект> ) \
  (факт домен $результат <факт> <предикат> )

данные использовать 2
данные новый
факт добавить i;всякий;квантор i;некоторый;квантор i;объект;квантор
факт добавить i;есть;связка 'i;не есть;связка'
для [ВсеСущности]
  факт добавить "i;[$ОбъектЦикла];субъект" "i;[$ОбъектЦикла];предикат"
следующий

ввести форма НовыйФакт 'Введите факт (F2 - подстановка значения из списка):' 'квантор;субъект;связка;предикат' 'всякий;;есть;'
данные использовать 1

если (память существует $результат НовыйФакт;квантор )
  >
  >ВВЕДЕНО: [НовыйФакт;квантор] [НовыйФакт;субъект] [НовыйФакт;связка] [НовыйФакт;предикат]
  список отобразить НовыйФакт;тип "[НовыйФакт;квантор] [НовыйФакт;связка]" 'всякий есть;всякий не есть;некоторый есть;некоторый не есть;объект есть;объект не есть' A;E;I;O;A;E ''
  Добавить_факт [НовыйФакт;тип] [НовыйФакт;субъект] [НовыйФакт;предикат]
конец
возврат

функция Добавить_факт тип субъект предикат
присвоить ОШИБКА ''

>Попытка ввода факта: [тип];[субъект];[предикат]

* 1) Общие проверки
если [субъект] == ''
  присвоить ОШИБКА 'Не указан субъект факта.' 
конец
если [предикат] == ''
  строка сцепить ОШИБКА $ 'Не указан предикат факта.' 
конец
если [ОШИБКА] == ''
  если [субъект] == [предикат]
    присвоить ОШИБКА 'Субъект и предикат факта должны отличаться.' 
  конец
конец

если [ОШИБКА] == ''
  факт сопоставитьМножество Типы "r;<факт>;[?X];[субъект];[предикат]" 
  присвоить ТипыПары {}
  для [Типы]
    список сцепить ТипыПары $ "[тип][$ОбъектЦикла]"
  следующий

* 2) Проверка на повторный ввод факта
  если (множество и $результат AA;EE;II;OO [ТипыПары] ) 
    присвоить ОШИБКА 'Такой факт уже известен.'
  конец
конец

* 3) Проверка на противоречие с существующими фактами
если [ОШИБКА] == ''
  множество и ТипыПротиворечивые [ТипыПары] AE;AO;EA;EI;IE;OA
  если [ТипыПротиворечивые]
    строка сцепить ОШИБКА "Факт не добавлен, т.к. он противоречит имеющемуся факту '" \
      (строка взять $результат [ТипыПротиворечивые] 2 ) ";[субъект];[предикат]'."
  конец
конец

* 4) Проверка на правила подчинения
если [ОШИБКА] == ''
  выбрать [тип]
    вариант A
      если (множество и $результат I [Типы] )
        факт удалить "r;<факт>;I;[субъект];[предикат]"
        >Удален факт 'I;[субъект];[предикат]'. Сработало правило подчинения Asp=>Isp.
      конец
    вариант E
      если (множество и $результат O [Типы] )
        факт удалить "r;<факт>;O;[субъект];[предикат]"
        >Удален факт 'O;[субъект];[предикат]'. Сработало правило подчинения Esp=>Osp.
      конец
    вариант I
      если (множество и $результат A [Типы] )
        присвоить ОШИБКА "Факт не введен. Есть более общий факт 'A;[субъект];[предикат]'. Сработало правило подчинения Asp=>Isp."
      конец
    вариант O
      если (множество и $результат E [Типы] )
        присвоить ОШИБКА "Факт не введен. Есть более общий факт 'E;[субъект];[предикат]'. Сработало правило подчинения Esp=>Osp."
      конец
  конецВыбора
конец

если [ОШИБКА] == ''
  факт добавить "r;<факт>;[тип];[субъект];[предикат]"
  >ДОБАВЛЕН ФАКТ: '[тип];[субъект];[предикат]'
  если [НовыйФакт;квантор] == объект
    факт добавить "i;[субъект];<объект>"  
  конец
иначе
  >ОШИБКА: [ОШИБКА]
конец
возврат

****** Просмотр базы фактов ******

функция Посмотреть_факты
память локальный Факт НомерФакта тип субъект предикат
>
>Факты в базе фактов:
>=================
>

присвоить НомерФакта 1
пока [НомерФакта] <= [$КоличествоФактов]
  факт взять Факт [НомерФакта]
  если (список сопоставить $результат [Факт] "r;<факт>;[?тип];[?субъект];[?предикат]" )
    печать (Посмотреть_факт [тип] [субъект] [предикат] )
  конец 
  увеличить НомерФакта
цикл
возврат

функция Посмотреть_факт тип субъект предикат
если (множество и $результат (понятие над $результат [субъект] ) <объект> )
  список отобразить тип [тип] A;E a;e [тип]
конец
список отобразить $результат [тип] A;E;I;O;a;e "Всякий [субъект] есть [предикат].;Всякий [субъект] не есть [предикат].;Некоторый [субъект] есть [предикат].;Некоторый [субъект] не есть [предикат].;[субъект] - [предикат].;[субъект] не [предикат]." '' 
возврат

****** Логический вывод на базе фактов ******

функция Вывод_новых_фактов
память локальный факт1 факт2 тип1 тип2 субъект1 субъект2 предикат1 предикат2 успешно1 успешно2
присвоить ОТРАБОТАВШИЕ_ПАРЫ_ФАКТОВ {}

>
>Логически выведены факты:
>======================
>

присвоить факт1 1
пока [факт1] <= [$КоличествоФактов]
  список сопоставить успешно1 (факт взять $результат [факт1] ) "r;<факт>;[?тип1];[?субъект1];[?предикат1]"
  если [успешно1]
    присвоить факт2 1
    пока [факт2] <= [$КоличествоФактов]
      если [факт1] <> [факт2]
        если (множество и $результат "[факт1],[факт2]" [ОТРАБОТАВШИЕ_ПАРЫ_ФАКТОВ] ) == {}
          список сопоставить успешно2 (факт взять $результат [факт2] ) "r;<факт>;[?тип2];[?субъект2];[?предикат2]"
          если [успешно2]
            если (множество и $результат "[субъект1];[предикат1]" "[субъект2];[предикат2]" ) 
            * Проверка, что имеется средний термин
              Применить_правило [факт1] [тип1] [субъект1] [предикат1] [факт2] [тип2] [субъект2] [предикат2]
            конец
          конец
        конец
      конец
      множество или ОТРАБОТАВШИЕ_ПАРЫ_ФАКТОВ $ "[факт1],[факт2]"
      увеличить факт2
    цикл
  конец
  увеличить факт1
цикл

возврат

функция Применить_правило факт1 тип1 субъект1 предикат1 факт2 тип2 субъект2 предикат2
память локальный тип субъект предикат

*>Проверка [факт1]:'[тип1];[субъект1];[предикат1]' и [факт2]:'[тип2];[субъект2];[предикат2]'

присвоить тип ''

* Фигура 1
если [субъект1] == [предикат2]
  присвоить субъект [субъект2] предикат [предикат1] 
  список отобразить тип "[тип1][тип2]" AA;EA;EI;AI A;E;O;I ''
конец

* Фигура 2
если [предикат1] == [предикат2]
  присвоить субъект [субъект2] предикат [субъект1] 
  список отобразить тип "[тип1][тип2]" EA;AE;EI;AO E;E;O;O '' 
конец

* Фигура 3
если [субъект1] == [субъект2]
  присвоить субъект [предикат2] предикат [предикат1] 
  список отобразить тип "[тип1][тип2]" AA;IA;AI;EA;OA;EI I;I;I;O;O;O '' 
конец

* Фигура 4
если [предикат1] == [субъект2]
  присвоить субъект [предикат2] предикат [субъект1] 
  список отобразить тип "[тип1][тип2]" AA;AE;IA;EA;EI I;E;I;O;O '' 
конец

если [тип]
  печать (Посмотреть_факт [тип] [субъект] [предикат] )
конец

возврат